home *** CD-ROM | disk | FTP | other *** search
/ PC World 2006 November / PCWorld_2006-11_cd.bin / domacnost a kancelar / findgraph / fgraph.exe / {app} / TestVB / Form1.frm < prev    next >
Text File  |  2005-10-13  |  11KB  |  386 lines
  1. VERSION 5.00
  2. Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
  3. Begin VB.Form Form1 
  4.    Caption         =   "FindGraph automation, sample 1"
  5.    ClientHeight    =   4140
  6.    ClientLeft      =   7365
  7.    ClientTop       =   345
  8.    ClientWidth     =   4980
  9.    LinkTopic       =   "Form1"
  10.    ScaleHeight     =   4140
  11.    ScaleWidth      =   4980
  12.    Begin VB.CommandButton Digitize 
  13.       Caption         =   "Digitize"
  14.       Height          =   516
  15.       Left            =   3360
  16.       Picture         =   "Form1.frx":0000
  17.       Style           =   1  'Graphical
  18.       TabIndex        =   5
  19.       ToolTipText     =   "Add picture and  digitize blue line"
  20.       Top             =   3480
  21.       Width           =   1452
  22.    End
  23.    Begin VB.CommandButton TestAddOne 
  24.       Caption         =   "Add One"
  25.       Height          =   516
  26.       Left            =   3360
  27.       Picture         =   "Form1.frx":0312
  28.       Style           =   1  'Graphical
  29.       TabIndex        =   2
  30.       ToolTipText     =   "Add 20 points on one"
  31.       Top             =   1318
  32.       Width           =   1452
  33.    End
  34.    Begin MSComctlLib.ListView ListView1 
  35.       Height          =   3375
  36.       Left            =   120
  37.       TabIndex        =   6
  38.       Top             =   600
  39.       Width           =   3135
  40.       _ExtentX        =   5530
  41.       _ExtentY        =   5953
  42.       View            =   3
  43.       LabelWrap       =   -1  'True
  44.       HideSelection   =   -1  'True
  45.       _Version        =   393217
  46.       ForeColor       =   -2147483640
  47.       BackColor       =   -2147483643
  48.       BorderStyle     =   1
  49.       Appearance      =   1
  50.       NumItems        =   0
  51.    End
  52.    Begin VB.CheckBox CheckVisible 
  53.       Caption         =   "Visible FindGraph"
  54.       Height          =   195
  55.       Left            =   3360
  56.       TabIndex        =   0
  57.       ToolTipText     =   "Show/Hide FindGraph"
  58.       Top             =   240
  59.       Value           =   1  'Checked
  60.       Width           =   1572
  61.    End
  62.    Begin VB.CommandButton TestProp 
  63.       Caption         =   "Properties"
  64.       Height          =   516
  65.       Left            =   3360
  66.       Picture         =   "Form1.frx":0624
  67.       Style           =   1  'Graphical
  68.       TabIndex        =   4
  69.       ToolTipText     =   "Change plot tile and scales"
  70.       Top             =   2760
  71.       Width           =   1452
  72.    End
  73.    Begin VB.CommandButton TestGet 
  74.       Caption         =   "Get"
  75.       Height          =   516
  76.       Left            =   3360
  77.       Picture         =   "Form1.frx":0936
  78.       Style           =   1  'Graphical
  79.       TabIndex        =   3
  80.       ToolTipText     =   "Create new area and get all points selected"
  81.       Top             =   2040
  82.       Width           =   1452
  83.    End
  84.    Begin VB.CommandButton TestAddArray 
  85.       Caption         =   "Add Array"
  86.       Height          =   516
  87.       Left            =   3360
  88.       Picture         =   "Form1.frx":0C48
  89.       Style           =   1  'Graphical
  90.       TabIndex        =   1
  91.       ToolTipText     =   "Add 500 points at once"
  92.       Top             =   600
  93.       Width           =   1452
  94.    End
  95. End
  96. Attribute VB_Name = "Form1"
  97. Attribute VB_GlobalNameSpace = False
  98. Attribute VB_Creatable = False
  99. Attribute VB_PredeclaredId = True
  100. Attribute VB_Exposed = False
  101. Private Declare Function GetModuleFileName Lib "kernel32" _
  102.          Alias "GetModuleFileNameA" _
  103.          (ByVal hModule As Long, _
  104.          ByVal lpFileName As String, _
  105.          ByVal nSize As Long) As Long
  106.  
  107. Dim FindGraph As Object
  108.  
  109. Sub LogError()
  110.     Print "error " & Err.Description
  111. End Sub
  112.  
  113.  
  114. Private Sub Form_Load()
  115.     On Error GoTo ErrHandler
  116.     ' Create object FindGraph
  117.     Set FindGraph = CreateObject("FindGraph.Document")
  118.     ' Run program FindGraph in new window
  119.     FindGraph.AppInit (1)
  120.     
  121.     Exit Sub
  122. ErrHandler:
  123.     LogError
  124.     Exit Sub
  125. End Sub
  126.  
  127. Private Sub Form_Unload(Cancel As Integer)
  128.     On Error GoTo ErrHandler
  129.     ' Close FindGraph application
  130.     FindGraph.AppQuit
  131. ErrHandler:
  132.     Set FindGraph = Nothing
  133. End Sub
  134.  
  135. ' The example how to hide/show FindGraph main window
  136. Private Sub CheckVisible_Click()
  137.     FindGraph.Visible = CheckVisible.Value 'True
  138. End Sub
  139.  
  140.  
  141. ' The example how to add series of points
  142. ' Create new series named "VB_series"
  143. ' Add 500 points at once
  144. Private Sub TestAddArray_Click()
  145.     On Error GoTo ErrHandler
  146.     Dim dwId, it, N As Long
  147.     Dim fX, fY, fZ As Double
  148.     
  149.     N = 500
  150.     Dim va(1500) As Variant ' dimension N*3
  151.      
  152.     ' Create new series of points
  153.     dwId = FindGraph.DotsNew(2, 2, 20, 1, "VB_series")
  154.     ' Set the identifier of a series
  155.     FindGraph.ArrayId = dwId
  156.     ' Fill array with points
  157.     For i = 1 To N
  158.         fX = CDbl(8# / N * i)
  159.         fY = CDbl(5# / N * i)
  160.         fZ = CDbl(i)
  161.         it = (i - 1) * 3
  162.         va(it) = fX
  163.         va(it + 1) = fY
  164.         va(it + 2) = fZ
  165.     Next i
  166.     ' Add all array at once
  167.     FindGraph.ArrayVar = va
  168.     ' Repaint points
  169.     FindGraph.DotsUpdate dwId
  170.     Exit Sub
  171. ErrHandler:
  172.     LogError
  173.     Exit Sub
  174. End Sub
  175.  
  176. ' The example how to add one point to series
  177. ' Create new series named "VB_point"
  178. ' Add 20 points on one
  179. Private Sub TestAddOne_Click()
  180.     On Error GoTo ErrHandler
  181.     Dim dwId, it, N As Long
  182.     Dim fX, fY, fZ As Double
  183.     
  184.     N = 20
  185.     ' Create new series of points
  186.     dwId = FindGraph.DotsNew(1, 1, 50, 1, "VB_point")
  187.     For i = 1 To N
  188.         fX = CDbl(0.3 * i)
  189.         fY = CDbl(0.4 * i)
  190.         ' Add single point to series
  191.         FindGraph.DotsAddPoint dwId, fX, fY, 0
  192.         ' Repaint points
  193.         FindGraph.DotsUpdate dwId
  194.     Next i
  195.     FindGraph.DotsUpdate dwId
  196.     Exit Sub
  197. ErrHandler:
  198.     LogError
  199.     Exit Sub
  200. End Sub
  201.  
  202.  
  203.  
  204. ' Create and select new area named "clip"
  205. ' Use nodes from VARIANT var array
  206. Private Sub NewClip()
  207.     Dim dwId As Long
  208.     On Error GoTo ErrHandler
  209.     dwId = FindGraph.ClipNewEmptyRgn(1) ' BLUE
  210.     FindGraph.ArrayId = dwId
  211.     ' Nodes (X,Y)
  212.     Dim va(12) As Variant ' dimension 4*3
  213.         va(0) = 1# '(1,5)
  214.         va(1) = 5#
  215.         va(2) = 0#
  216.         va(3) = 5# '(5,8)
  217.         va(4) = 8#
  218.         va(5) = 1#
  219.         va(6) = 7# '(7,5)
  220.         va(7) = 5#
  221.         va(8) = 2#
  222.         va(9) = 5# '(5,1)
  223.         va(10) = 1#
  224.         va(11) = 3#
  225.     ' Create array of nodes
  226.     FindGraph.ArrayVar = va
  227.     ' Select the area
  228.     FindGraph.ClipSelect dwId, 1
  229.     
  230.     Exit Sub
  231. ErrHandler:
  232.     LogError
  233.     Exit Sub
  234. End Sub
  235.  
  236. ' The example how to create new area and get all points selected
  237. Private Sub TestGet_Click()
  238.     On Error GoTo ErrHandler
  239.     Dim fX, fY, fZ As Double
  240.     ListInit
  241.     ' Create new area and select it
  242.     NewClip
  243.     
  244.    ' GoTo ByOne
  245. ByVar:
  246.     ' The example how to get whole array of points immediately
  247.     ' Points - three-tuples (X,Y,Z)
  248.     ' Copy selected points, put it on the buffer.
  249.     ' N number of points selected
  250.     N = FindGraph.SelectedGetStart(0)
  251.     Dim va As Variant
  252.     va = FindGraph.ArrayVar
  253.     NGet = (UBound(va) + 1) / 3
  254.     If N > NGet Then N = NGet
  255.     Print "ub"; UBound(va)
  256.     ' Fill the grid with points (X, Y, Z)
  257.     For i = 1 To N
  258.         it = 3 * (i - 1)
  259.         fX = va(it)
  260.         fY = va(it + 1)
  261.         fZ = va(it + 2)
  262.         ListAdd fX, fY, fZ
  263.     Next i
  264.     ' Free memory
  265.     FindGraph.SelectedGetStop (0)
  266.     Exit Sub
  267.      
  268. ByOne:
  269.     ' The example how to get single point
  270.     ' Points - three-tuples (X,Y,Z)
  271.     ' Copy selected points, put it on the buffer.
  272.     ' N number of points selected
  273.     N = FindGraph.SelectedGetStart(0)
  274.     Print "n"; N
  275.     ' In cycle we choose points and add to grid
  276.     For i = 1 To N
  277.         fX = FindGraph.SelectedGetX(i - 1)
  278.         fY = FindGraph.SelectedGetY(i - 1)
  279.         fZ = FindGraph.SelectedGetZ(i - 1)
  280.         ListAdd fX, fY, fZ
  281.     Next i
  282.     ' Free memory
  283.     FindGraph.SelectedGetStop (0)
  284.     Exit Sub
  285.    
  286.   
  287. ErrHandler:
  288.     LogError
  289.     Exit Sub
  290. End Sub
  291. ' The example how to change plot properties
  292. Private Sub TestProp_Click()
  293.     On Error GoTo ErrHandler
  294.     ' Change the title
  295.     FindGraph.DocTitle = "From VB title"
  296.     ' Change the scale of X axe
  297.     FindGraph.AxeXscale = 2
  298.     ' Repaint
  299.     FindGraph.DocUpdate
  300.     Exit Sub
  301. ErrHandler:
  302.     LogError
  303.     Exit Sub
  304. End Sub
  305.  
  306.  
  307. ' The example how to digitize the background picture
  308. ' Display the background picture
  309. ' Create rectangle area and select it
  310. ' Digitize blue line inside rectangle
  311. ' Create new series named "FromPict"
  312. ' Assign green color and radius of circle 1 mm to points of series
  313. Private Sub Digitize_Click()
  314.     On Error GoTo ErrHandler
  315.     
  316.     'Get file name from module path and exe name
  317.     Dim strFileName As String
  318.     Dim lngCount As Long
  319.     strFileName = String(512, 0)
  320.     lngCount = GetModuleFileName(App.hInstance, strFileName, 512)
  321.     strFileName = Left(strFileName, lngCount - 10) & "money.gif"
  322.    
  323.     ' Change the title
  324.     FindGraph.DocTitle = "Digitize Now"
  325.     ' Set background picture file name
  326.     'FindGraph.DocPictFileName = "d:\vc\FindGraph\TestVB\money.gif"
  327.     FindGraph.DocPictFileName = strFileName
  328.     ' Display background picture
  329.     FindGraph.DocPictIs = True
  330.     ' rectangle in physical units from (1,4) to (10,8)
  331.     ' Get axes scales
  332.     Dim fXStart, fXScale, fYStart, fYScale As Double
  333.     fXStart = FindGraph.AxeXstart
  334.     fXScale = FindGraph.AxeXscale
  335.     fYStart = FindGraph.AxeYstart
  336.     fYScale = FindGraph.AxeYscale
  337.     
  338.     ' Calculate rectangle
  339.     Dim fLeft, fTop, fRight, fBottom As Double
  340.     fLeft = fXStart + fXScale * 1#
  341.     fTop = fYStart + fYScale * 4#
  342.     fRight = fXStart + fXScale * 10#
  343.     fBottom = fYStart + fYScale * 8#
  344.     
  345.      ' Create rectangle area with color number = 2 (GREEN)
  346.     Dim dwIdArea As Long
  347.     dwIdArea = FindGraph.ClipNewRect(2, fLeft, fTop, fRight, fBottom)
  348.      ' Select area
  349.     FindGraph.ClipSelect dwIdArea, 1
  350.     
  351.     
  352.     ' Digitize points inside rectangle
  353.     ' Color number = 1 (BLUE)
  354.     ' Radius of digitizing = 20 (2.0 mm)
  355.     Dim dwIdDots As Long
  356.     dwIdDots = FindGraph.DotsFromPict(1, 20, "FromPict")
  357.     ' Assign green color, color number = 2 (GREEN)
  358.     FindGraph.DotsColorNumSet dwIdDots, 2
  359.     ' Assign radius of new points = 10 (1.0 mm)
  360.     FindGraph.DotsWidthSet dwIdDots, 10
  361.       
  362.     ' Repaint
  363.     FindGraph.DocUpdate
  364.     Exit Sub
  365. ErrHandler:
  366.     LogError
  367.     Exit Sub
  368. End Sub
  369. Private Sub ListInit()
  370.     ListView1.ListItems.Clear
  371.     Dim Col As ColumnHeader ' Declare variable
  372.     Set Col = ListView1.ColumnHeaders.Add(, , "X", ListView1.Width / 3)
  373.     Set Col = ListView1.ColumnHeaders.Add(, , "Y", ListView1.Width / 3)
  374.     Set Col = ListView1.ColumnHeaders.Add(, , "Z", ListView1.Width / 3)
  375. End Sub
  376.  
  377. Private Sub ListAdd(X, Y, Z)
  378.     Dim Insert As ListItem
  379.     Set Insert = ListView1.ListItems.Add(, , CStr(X))
  380.     Insert.SubItems(1) = CStr(Y)
  381.     Insert.SubItems(2) = CStr(Z)
  382. End Sub
  383.  
  384.  
  385.  
  386.